VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsFTP"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' SUBJECT:      clsFTP
' AUTHOR:       David M Swan
'                      Progress Software Corporation
'                      Crescent Division
'
' CREATED:     December 8, 1996
'
' REVISION
' HISTORY:
'
' DESCRIPTION: Encapsulates many of the CIFTP control's functions in a class module
'                         See FtpClass.wri for detailed description of the class.
'
' PUBLIC
' INTERFACE: FUNCTIONS - bLogin, bLogout, bGetDirectory, bGetFile, bPutFile, bAbort,
'                                            sGetLastError, lTotalDataBytesIn, lTotalDataBytesOut
'
' PUBLIC PROPERTIES - iTimeoutValue, bDumpAccessPackets, bDumpDataPackets
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

' ========================
' Define the public class members:
' ========================

Public iTimeoutValue As Integer ' max # of seconds to wait for a server response before bailing out. Set to 0 for infinite wait
' Debug control flags...
Public bDumpAccessPackets  As Boolean       ' Controls whether Access Control Packets are dumped to debug window
Public bDumpDataPackets  As Boolean           ' Controls whether Data Channel Packets are dumped to debug window

' ========================
' Define the private class members:
' ========================
Private objFTP As CIFTP                 ' The FTP control being encapsulated - This is set in bInit
Private bInitialized As Boolean         ' Set to True once bInit has been called successfully
Private bUserLoggingOut As Boolean      ' Flag indicating whether the user is logging out (set to True in user func bLogout)
                                                            ' This is used to determine if the Access Channel is closing due to a logout request (via bLogout)
                                                            ' or was initiated by the server.
Private bAccessControlChannelOpen As Boolean      ' Set to True when EventState = CIFTP_ACCONN
                                                                             ' Set to False when EventState = CIFTP_ACCLOSED
Private bDataControlChannelOpen As Boolean          ' Set to True when EventState = CIFTP_DCCONN
                                                                             ' Set to False when EventState = CIFTP_DCCLOSED
Private dtLastUserRequest As Date ' Time at which the user last called a public function
Private dtLastServerResponse As Date ' Used to track the time the last server data was received
                                                         ' (Set in: DataControlPacketRecieved/Sent, EventStateChanged and ServerResponse Events)

Private sCurrUserFuncName As String ' Name of the currently executing client function
Private bFileClosed As Boolean ' Set to True in EventStateChanged, to False in bExecCmd.  Used for LIST and RETR cmd processing

Private m_lTotalDataBytesIn As Long ' counter for total bytes that come in during a data transfer (to the client -- RETR)
Private m_lTotalDataBytesOut As Long ' counter for total bytes that are sent out during a data transfer (to the server -- STOR)
' Note use the corresponding public Property Get functions to access these from client code

' Consts identifying each of the public functions (used by DumpFTPSettings)
Private Const USER_FUNC_NONE As Byte = 0
Private Const USER_FUNC_LOGIN As Byte = 1
Private Const USER_FUNC_LOGOUT As Byte = 2
Private Const USER_FUNC_GET_DIR As Byte = 3
Private Const USER_FUNC_GET_FILE As Byte = 4
Private Const USER_FUNC_PUT_FILE As Byte = 5

Private Const DEFAULT_TIMEOUT As Integer = 60 ' Default timeout in seconds

Private Const ERROR_TYPE_NONE As Byte = 0           ' No Error
Private Const ERROR_TYPE_WSA As Byte = 1            ' WSAError event fired
Private Const ERROR_TYPE_INTERNET As Byte = 2    ' InternetError event fired
Private Const ERROR_TYPE_OTHER As Byte = 3       ' Catch all for all other types of errors
                                                          ' These are either usually caused by bad parameters
                                                          ' or an attempt by the user to call a function without
                                                          ' having the system in the proper state (e.g. calling a
                                                          ' function w/o first logging in)
                                                          
' Values when LastError.iType = ERROR_TYPE_OTHER
' ========================================
Private Const ERR_ROUTINE_ERROR As Byte = 1
Private Const ERR_BAD_OR_MISSING_PARAM As Byte = 2
Private Const ERR_USER_ERROR As Byte = 3 ' e.g. user called Init but the class is already initialized
Private Const ERR_CLASS_NOT_INITIALIZED As Byte = 4 ' user is calling a function w/o first initializing the class
Private Const ERR_UNEXPECTED_STATE As Byte = 5  ' e.g. user calls bLogout, but there access channel is closed
Private Const ERR_SERVER_REQUEST_FAILED As Byte = 6 ' catch all for errors calling bExecCmd
Private Const ERR_ACCESS_CONN_LOST As Byte = 7 ' set in the case that the access channel drops unexpectedly
Private Const ERR_TIMED_OUT As Byte = 8 ' timeout period expired waiting on an operation to complete
Private Const ERR_INVALID_FUNC_CALL As Byte = 9 ' user attempted to call a function before another function had completed
Private Const ERR_CMD_ABORTED As Byte = 10 ' the user called bAbort while a user function was executing
Private Const ERR_INVALID_ABORT As Byte = 11 ' the user called bAbort, but no function was executing at the time
Private Const ERR_NOT_CONNECTED As Byte = 12 ' attempted to call a function but there is no server connection

Private Type udtERROR
  iType As Integer      ' NONE, OTHER, WSA, or INTERNET
  lCode As Long
End Type
Private LastError As udtERROR       ' Used to track error settings.  Use SetError to load the structure

Private iInternaleError As Integer  ' Used to save Err.Number when an internal error occurs

' As server responses come in (via the CIFTP.ServerResponse event firing), we queue the information so
' that we can determine the result of server requests.  The sequence is as follows: (1) We establish a
' data channel if necessary, (2) We issue a server request via bExecCmd, (3) As response(s) come in from
' the server, we queue them via AddToSRQueue, (4) We wait for the server's response via bWaitOnServerResponse.
' This routine looks in the response queue to determine the result of the request.  All of these functions are
' private (and therefore hidden from the user).

Private Type SR_NODE
  iCode As Integer
  sMsg As String
End Type

Private Const QUEUE_SIZE As Byte = 10
Private SRQueue(1 To QUEUE_SIZE) As SR_NODE
Private iQPos As Integer   ' current Queue position

' Consts representing the commands supported by bExecCmd function...
'====================================================
Private Const CMD_USER          As Byte = 1
Private Const CMD_PASS          As Byte = 2
Private Const CMD_CWD           As Byte = 3
Private Const CMD_CDUP          As Byte = 4
Private Const CMD_QUIT            As Byte = 5
Private Const CMD_PASV          As Byte = 6
Private Const CMD_TYPE          As Byte = 7
Private Const CMD_STOR          As Byte = 8
Private Const CMD_RETR          As Byte = 9
Private Const CMD_LIST            As Byte = 10
Private Const CMD_APPE          As Byte = 11
Private Const CMD_PWD           As Byte = 12
Private Const CMD_SYST          As Byte = 13
Private Const NUM_SUPPORTED_CMDS As Byte = 13 ' MAKE SURE TO INCREASE THIS IF YOU ADD ADDITIONAL COMMANDS!!!

Private Const SUCCESS As Byte = 1
Private Const FAILURE As Byte = 2

Private Const MAX_CODES As Byte = 15 ' Max # of codes indicating success or failure of a given server request

' This array represents the FTP state machine.  The first dimension represents the ftp command being executed.
' The second dimension represents success or failure and the third dimension is the set of possible result codes
' for that particular command's successfull/failing values.  The machine is initialized at startup by InitFTPStateMachine
Private iFTPStateMachine(1 To NUM_SUPPORTED_CMDS, 1 To 2, 1 To MAX_CODES) As Integer

  

' Ideas for future enhancements...
' ============================

' 1) Add an error collection
' 2) Add an actions (audit trail) collection to track each requested action and it's result.
' 2a) Audit trail log file
' 3) Optionally dump "DP" output to a window for run-time debugging/tracking
' 4) Add auto reconnect if the ftp server drops a connection after a period of inactivity.
' 5) Wrap the control's high level methods
' 6) Implement a function that wraps the SendFTPCommand function

'====================================================
'   +++ Public Routine Implementation Starts Here +++
'====================================================

Public Function bInit(FTP As CIFTP) As Boolean

' Usage: Users MUST call this function first passing the CIFTP control they wish to wrap as the sole argument
  
  On Error GoTo bInit_ErrHdlr
  
  ClearErrorFlags
  dtLastUserRequest = Now
  
  If bInitialized Then
    bInit = False
    SetError ERR_USER_ERROR
    DP "ERROR - bInit already called!"
  Else
    Set objFTP = FTP
    InitFTPStateMachine
    bInitialized = True
    bInit = True
  End If
  
  Exit Function
  
bInit_ErrHdlr:
  HandleInternalError
  
End Function ' bInit

Public Function bLogin(Optional vntHostName, Optional vntLoginName, Optional vntPassword, Optional vntWorkingDirectory) As Boolean
    
' Usage: After calling bInit, you can call this function to establish a connection with an ftp server.  Be sure to either set the
'            HostName, LoginName and Password properties in the CIFTP control or pass these as arguments to the function.
'            This wraps the ConnectToAccessControlChannel, USER, PASS, CWD and PWD methods.

'            Note that you can pass either the host name or an ip address in the vntHostName argument.

  Dim bSuccess As Boolean
  Const SR_USER_OK_NEED_PASS As Integer = 331
  
  On Error GoTo bLogin_ErrHdlr
  
  bLogin = False ' Assume worst case
  
  If Not bInitUserCall("bLogin") Then Exit Function 'GoTo bLogin_GetOut
  
  ' Handle optional params...
  If Not IsMissing(vntHostName) Then
    ' Determine if it's an IP address...
    If bIsIPAddress(CStr(vntHostName)) Then
      objFTP.HostAddress = CStr(vntHostName)
    Else
      objFTP.HostName = CStr(vntHostName)
    End If
  End If
  If Not IsMissing(vntLoginName) Then objFTP.LoginName = CStr(vntLoginName)
  If Not IsMissing(vntPassword) Then objFTP.Password = CStr(vntPassword)
  If Not IsMissing(vntWorkingDirectory) Then objFTP.WorkingDirectory = CStr(vntWorkingDirectory)
  
  DumpFTPSettings (USER_FUNC_LOGIN)  ' Dump relevant FTP login settings
  
  ' Make sure that either a host name or address has been set...
  If objFTP.HostName = "" And objFTP.HostAddress = "" Then
    SetError ERR_BAD_OR_MISSING_PARAM
    DP "ERROR: HostName or HostAddress must be set"
    GoTo bLogin_GetOut
  End If
  
  ' Establish an access control channel with the ftp server...
  If Not bConnectToAccessControlChannel() Then GoTo bLogin_GetOut
      
  ' Login and set the working directory...
  If Not bExecCmd(CMD_USER) Then GoTo bLogin_GetOut
  ' Only send the password if the server requires it...
  If bCheckSRQueue(SR_USER_OK_NEED_PASS) Then
    DP "Server needs PASS, sending..."
    If Not bExecCmd(CMD_PASS) Then GoTo bLogin_GetOut
  End If
  
  ' (Possibly) change to the dir specified in the WorkingDirectory property
  If objFTP.WorkingDirectory <> "" Then
    If Not bExecCmd(CMD_CWD) Then GoTo bLogin_GetOut
  End If
  
  ' Update the WorkingDirectory property...
  If Not bExecCmd(CMD_PWD) Then GoTo bLogin_GetOut
                
  bLogin = True ' if we got here, then we've successfully connected
    
bLogin_GetOut:
  
  EndUserCall
  Exit Function
  
bLogin_ErrHdlr:
  HandleInternalError
  EndUserCall

End Function ' bLogin

Public Function bGetFile(Optional vntLocalFileName, Optional vntRemoteFileName, Optional vntBinaryFile) As Boolean
 
' Usage: Get a file using the low level ftp methods.  Be sure to set the CIFTP control's LocalFileName, RemoteFilename properties
'             before calling this function or pass these as arguments to the funciton.  This wraps the PASV, ConnectToDataChannel
'             and RETR methods.  If vntBinaryFile is True then the RepresentationType is set to binary (I) otherwise it is set
'             to ASCII.  If it is not supplied, binary is assumed

  Dim bSuccess As Boolean, bBinaryFile As Boolean
 
  On Error GoTo bGetFile_ErrHdlr
  
  bGetFile = False ' Assume worst case.
  
  If Not bInitUserCall("bGetFile") Then Exit Function 'GoTo bGetFile_GetOut
    
  ' Handle optional parameters...
  If Not IsMissing(vntLocalFileName) Then objFTP.LocalFileName = CStr(vntLocalFileName)
  If Not IsMissing(vntRemoteFileName) Then objFTP.RemoteFileName = CStr(vntRemoteFileName)
  If Not IsMissing(vntBinaryFile) Then
    bBinaryFile = CBool(vntBinaryFile)
  Else
    bBinaryFile = True ' Treat as a binary file if not specified.
  End If
                                        
  DumpFTPSettings (USER_FUNC_GET_FILE)  ' Dump relevant FTP settings for getting a file

  ' Make sure we're logged in!
  If Not bLoggedIn() Then
    HandleNotLoggedIn
    GoTo bGetFile_GetOut
  End If
                    
  ' Check to make sure local/remote file names have been set...
  If objFTP.LocalFileName = "" Or objFTP.RemoteFileName = "" Then
    DP "ERROR: Local and/or Remote File Name Not Specified"
    SetError ERR_BAD_OR_MISSING_PARAM
    GoTo bGetFile_GetOut
  End If
    
  ' Set the RepresentationType and call the TYPE method...
  If bBinaryFile Then
    objFTP.RepresentationType = "I"
  Else
    objFTP.RepresentationType = "A"
  End If
  If Not bExecCmd(CMD_TYPE) Then GoTo bGetFile_GetOut
    
  ' Establish a data channel with the ftp server...This will call PASV and ConnectToDataChannel
  If Not bConnectToDataChannel() Then GoTo bGetFile_GetOut
  
  ' We now have a data channel, so we can call RETR...
  If Not bExecCmd(CMD_RETR) Then GoTo bGetFile_GetOut
  
  ' If we've gotten here, then the command was successful
  bGetFile = True
  DP "Total bytes received: " & lTotalDataBytesIn

bGetFile_GetOut:
  
  EndUserCall
  
  Exit Function
  
bGetFile_ErrHdlr:
  HandleInternalError
  EndUserCall
  
End Function ' bGetFile

Public Function bPutFile(Optional vntLocalFileName, Optional vntRemoteFileName, Optional vntBinaryFile, Optional vntAppend) As Boolean
 
' Usage: Put a file using the low level ftp methods.  Be sure to set the CIFTP control's LocalFileName, RemoteFilename properties
'             before calling this function or pass these as arguments to the funciton.  If you wish to append to a file on the server you
'             must pass the optional append argument to the routine (as True).  This wraps the PASV, ConnectToDataChannel
'             and STOR/APPE methods.  If vntBinaryFile is True then the RepresentationType is set to binary (I) otherwise it is set
'             to ASCII.  If it is not supplied, binary is assumed

  Dim bSuccess As Boolean, bAppendToFile, bBinaryFile As Boolean
 
  On Error GoTo bPutFile_ErrHdlr
  
  bPutFile = False ' Assume worst case.
  
  If Not bInitUserCall("bPutFile") Then Exit Function 'GoTo bPutFile_GetOut
    
  ' Handle optional parameters...
  If Not IsMissing(vntLocalFileName) Then objFTP.LocalFileName = CStr(vntLocalFileName)
  If Not IsMissing(vntRemoteFileName) Then objFTP.RemoteFileName = CStr(vntRemoteFileName)
  If Not IsMissing(vntAppend) Then bAppendToFile = CBool(vntAppend)
  If Not IsMissing(vntBinaryFile) Then
    bBinaryFile = CBool(vntBinaryFile)
  Else
    bBinaryFile = True ' Treat as a binary file if not specified.
  End If
                    
  DumpFTPSettings (USER_FUNC_PUT_FILE)  ' Dump relevant FTP settings for putting a file

  ' Make sure we're logged in!
  If Not bLoggedIn() Then
    HandleNotLoggedIn
    GoTo bPutFile_GetOut
  End If
                    
  ' Check to make sure local/remote file names have been set...
  If objFTP.LocalFileName = "" Or objFTP.RemoteFileName = "" Then
    DP "ERROR: Local and/or Remote File Name Not Specified"
    SetError ERR_BAD_OR_MISSING_PARAM
    GoTo bPutFile_GetOut
  End If
    
  ' Set the RepresentationType and call the TYPE method...
  If bBinaryFile Then
    objFTP.RepresentationType = "I"
  Else
    objFTP.RepresentationType = "A"
  End If
  If Not bExecCmd(CMD_TYPE) Then GoTo bPutFile_GetOut
  
  ' Establish a data channel with the ftp server...This will call PASV and ConnectToDataChannel
  If Not bConnectToDataChannel() Then GoTo bPutFile_GetOut
  
  ' We now have a data channel, so we can call STOR/APPE...
  If bAppendToFile Then
    bSuccess = bExecCmd(CMD_APPE)
  Else
    bSuccess = bExecCmd(CMD_STOR)
  End If
  If Not bSuccess Then GoTo bPutFile_GetOut
  
  ' If we've gotten here, then the command was successful
  bPutFile = True
  DP "Total bytes sent: " & lTotalDataBytesOut

bPutFile_GetOut:
  
  EndUserCall
  
  Exit Function
  
bPutFile_ErrHdlr:
  HandleInternalError
  EndUserCall
  
End Function ' bPutFile

Public Function bGetDirectory(Optional vntWorkingDirectory) As Boolean
  
' Usage: Use this function to populate the files collection and dir/files list boxes.  Be sure to set
' the WorkingDirectory property to the desired location before invoking this function or pass this as
' an argument to the function.  This wraps the ConnectToDataChannel, CWD, LIST and PWD methods.

  Dim bSuccess As Boolean
  
  On Error GoTo bGetDirectory_ErrHdlr
  
  bGetDirectory = False  ' Assume worst case
  
  If Not bInitUserCall("bGetDirectory") Then Exit Function 'GoTo bGetDirectory_GetOut
                          
  ' Make sure we're logged in!
  If Not bLoggedIn() Then
    HandleNotLoggedIn
    GoTo bGetDirectory_GetOut
  End If
  
  ' Handle optional argument...
  If Not IsMissing(vntWorkingDirectory) Then objFTP.WorkingDirectory = CStr(vntWorkingDirectory)
  
  ' NOTE: If the LocalFileName property is set when you call the list method, the resulting output
  ' is dumped to the specified file.  Therefore, be sure to reset this to a known value after doing
  ' a get or a put or else you may accidentally overwrite a file you didn't intend to.
  ' We set it to a file in the application directory here so that the FileClosed event will fire at the end
  ' of the LIST function.
  objFTP.LocalFileName = App.Path & "\$$FtpDir.tmp"
  
  DumpFTPSettings (USER_FUNC_GET_DIR)  ' Dump relevant FTP Get dir settings
  
  ' Set type to ASCII...
  objFTP.RepresentationType = "A"
  bSuccess = bExecCmd(CMD_TYPE)
  If Not bSuccess Then GoTo bGetDirectory_GetOut
                                                             
  ' Get a data channell...
  bSuccess = bConnectToDataChannel() ' this will call PASV and ConnectToDataChannel
  If Not bSuccess Then GoTo bGetDirectory_GetOut
    
  ' (Possibly) change dirs to that specified in the WorkingDirectory property
  bSuccess = bExecCmd(CMD_CWD)
  If Not bSuccess Then GoTo bGetDirectory_GetOut
   
  ' Now execute the list command to update the files collection and list boxes
  bSuccess = bExecCmd(CMD_LIST)
  If Not bSuccess Then GoTo bGetDirectory_GetOut
  
  ' Update the WorkingDirectory property
  bSuccess = bExecCmd(CMD_PWD)
   
bGetDirectory_GetOut:
  
  bGetDirectory = bSuccess
  EndUserCall
  Exit Function
  
bGetDirectory_ErrHdlr:
   HandleInternalError
   EndUserCall
  
End Function ' bGetDirectory

Public Function bLogout() As Boolean
  
' Usage: Terminate the connection (established by bLogin) to the ftp server

  On Error GoTo bLogout_ErrHdlr
  
  bLogout = False ' Assume worst case
  
  If Not bInitUserCall("bLogout") Then Exit Function 'GoTo bLogout_GetOut
  
  ' Make sure we're logged in!
  If Not bLoggedIn() Then
    HandleNotLoggedIn
    GoTo bLogout_GetOut
  End If
  
  ' Set flag indicating user is initiating shutdown.  This is looked at in EventStateChanged when
  ' the access channel closes.  If it is unexpected, corrective action can be taken.
  bUserLoggingOut = True

  bLogout = bExecCmd(CMD_QUIT)
  
bLogout_GetOut:
  
  EndUserCall
    
  Exit Function
  
bLogout_ErrHdlr:
  HandleInternalError
  EndUserCall

End Function ' bLogout

Public Function bAbort() As Boolean

'Usage: Abort the currently executing user command.

  If sCurrUserFuncName <> "" Then ' abort the currently executing user request
    SetError ERR_CMD_ABORTED
    bAbort = True
    ' If the data channel is active, then terminate it via the CleanupDataConnection method
    ' This allows users to abort file transfers
    If bDataControlChannelOpen Then
      DP "Operation terminated via bAbort, closing data channel..."
      CloseDataControlChannel
    End If
  Else ' no user request is currently under way, so there is nothing to abort
    SetError ERR_INVALID_ABORT
    bAbort = False
  End If
  
End Function ' bAbort

Public Function sGetLastError() As String
 
' Usage: If an error occurs, use this function to get a human readable description of the problem

  Dim sErr As String
  
  On Error Resume Next
  
  Select Case LastError.iType
    Case ERROR_TYPE_NONE           ' No Error
      sErr = "No Error"
    Case ERROR_TYPE_WSA             ' WSAError event fired
      sErr = "WSAError - " & WSAErrDescription(CInt(LastError.lCode))
    Case ERROR_TYPE_INTERNET     ' InternetError event fired
      sErr = "InternetError - " & InternetErrDescription(LastError.lCode)
    Case ERROR_TYPE_OTHER     ' There was an internal error in the routine (possibly caused by bad/missing user param)
      sErr = sGetOtherError()
    Case Else
      sErr = "Unknown Error Type!"
  End Select
  
  sGetLastError = sErr
  
End Function ' sGetLastError

Public Sub ServerResponse(ByVal iCode As Integer, sMsg As String)

' Usage: This MUST be called from the ServerResponse event code for the CIFTP control that is being wrapped

  AddToSRQueue iCode, sMsg
  dtLastServerResponse = Now ' record the time that server last sent info

End Sub ' ServerResponse

Public Sub EventStateChanged(iState As Integer)

' Usage: This MUST be called from the EventStateChanged event code for the CIFTP control that is being wrapped

  On Error GoTo EventStateChanged_ErrHdlr
  
  Select Case iState
    
    Case CIFTP_FCLOSED ' File Closed
      DP "File Closed"
      bFileClosed = True  ' used to end LIST and RETR calls
      
      Case CIFTP_SCLOSED ' Socket Closed
      DP "Socket Closed"
    
    Case CIFTP_ACCONN ' Access Control Channel Connection
      DP "AccessControlChannelConnection"
      bAccessControlChannelOpen = True
          
    Case CIFTP_ACCLOSED ' Access Channel Closed
      DP "AccessControlChannelClosed"
      If Not bUserLoggingOut Then
        ' To-do: Logic to handle case where access control channel is unexpectedly dropped...
        DP "Timeout may have occured.  Access channel lost at " & Now
        DP "Last user request occured at " & dtLastUserRequest
        SetError (ERR_ACCESS_CONN_LOST)
      End If
      bAccessControlChannelOpen = False
        
    Case CIFTP_DCCONN ' Data Channel Connection
      DP "Data control connection established"
      bDataControlChannelOpen = True
      m_lTotalDataBytesIn = 0
      m_lTotalDataBytesOut = 0
      
    Case CIFTP_DCCLOSED ' Data Channel Connection Closed
      DP "Data control connection closed"
      bDataControlChannelOpen = False
      
    Case CIFTP_DPORTSET ' Data Port Set
      DP "DataPortSet"
'
    Case CIFTP_LBPOP ' List Boxes Populated
      DP "List Boxes Populated"
      
     Case Else
       DP "Unknown event state (" & iState & ")"
    
  End Select
  
  dtLastServerResponse = Now ' record the time that info was recieved
  
  Exit Sub
  
EventStateChanged_ErrHdlr:
  HandleInternalError
    
End Sub ' EventStateChanged

Public Sub AccessControlPacketReceived(ByRef Packet As String)

' Usage: This should be called from the AccessControlPacketReceived event code for the CIFTP control that is being wrapped if
'             you wish to have the wrapper class track these packets.
    
  If bDumpAccessPackets Then
    DP "+++ Access Packet Start +++"
    DP Packet
    DP "+++ Access Packet End +++" & vbCrLf
  Else
    DP "AccessControlPacketReceived"
  End If
  
  dtLastServerResponse = Now ' record the time that the data was recieved
  
End Sub ' AccessControlPacketReceived

Public Sub DataControlPacketReceived(ByRef Packet As String, ByVal bytes_in As Integer)
  
' Usage: This should be called from the DataControlPacketReceived event code for the CIFTP control that is being wrapped if
'             you wish to have the wrapper class track these packets.  If you wish to use the timeout facilities provided by the wrapper
'             you need to call this routine since it monitors the time at which packets are received.
  
  If bDumpDataPackets Then
    DP vbCrLf
    DP "--- Data Packet Start ---"
    DP Packet
    DP "--- Data Packet End [" & bytes_in & " bytes] ---" & vbCrLf
  Else
    DP "DataControlPacketReceived (" & bytes_in & ")"
  End If
  m_lTotalDataBytesIn = m_lTotalDataBytesIn + bytes_in
  
  dtLastServerResponse = Now ' record the time that data was last recieved
  
End Sub ' DataControlPacketReceived

Public Sub DataControlPacketSent(ByVal bytes_out As Integer)
  
' Usage: This should be called from the DataControlPacketSent event code for the CIFTP control that is being wrapped if
'             you wish to have the wrapper class track these packets.  If you wish to use the timeout facilities provided by the wrapper
'             you need to call this routine since it monitors the time at which packets are received.
  
  DP "DataControlPacketSent (" & bytes_out & ")"
  m_lTotalDataBytesOut = m_lTotalDataBytesOut + bytes_out   ' update byte count
    
  dtLastServerResponse = Now ' record the time that data was last sent
    
End Sub ' DataControlPacketSent

Public Sub InternetError(ByVal lErrorNumber As Long, ByRef sErrorMsg As String)
  
' Usage: This MUST be called from the InternetError event code for the CIFTP control that is being wrapped
'            NOTE: The high level methods are not currently wrapped by this class, so you can safely ommit this call.

  DP "InternextError (" & lErrorNumber & ") - " & InternetErrDescription(lErrorNumber)
  SetError lErrorNumber, ERROR_TYPE_INTERNET
  
End Sub ' InternetError

Public Sub WSAError(ByVal iErrorNumber As Integer)
  
' Usage: This MUST be called from the WSAError event code for the CIFTP control that is being wrapped
  
  ' There appears to be a bug in the CIFTP control which causes an error of -10000 to be incorrectly raised.
  ' Since this does not represent a real error, we'll ignore this special case.
  If iErrorNumber = -10000 Then
    ' ignore this isn't a real error
  Else
    DP "WSAError (" & iErrorNumber & ") - " & WSAErrDescription(iErrorNumber)
    SetError CLng(iErrorNumber), ERROR_TYPE_WSA
  End If
  
End Sub 'WSAError

Public Function bLoggedIn() As Boolean
'Usage: determine if the user is logged in.  Imperfect since we just check if the access control channel is open
  bLoggedIn = (bAccessControlChannelOpen = True)
End Function ' bLoggedIn

Public Property Get lTotalDataBytesIn() As Long
' Usage: provides read-only access to the # of bytes RECEIVED on the data control channel
' This is usefull for tracking the status of RETR operations
  lTotalDataBytesIn = m_lTotalDataBytesIn
End Property

Public Property Get lTotalDataBytesOut() As Long
' Usage: provides read-only access to the # of bytes SENT on the data control channel
' This is usefull for tracking the status of STOR/APPE operations
  lTotalDataBytesOut = m_lTotalDataBytesOut
End Property


'====================================================
'   +++ Private Routine Implementation Starts Here +++
'====================================================

Private Sub InitFTPStateMachine()
  
' Load the state array with the possible server response codes for the supported commands...

  DP "Initializing state machine..."
  ' USER
  iFTPStateMachine(CMD_USER, SUCCESS, 1) = 230 ' logged in
  iFTPStateMachine(CMD_USER, SUCCESS, 2) = 331 ' user ok, need pass
    
  iFTPStateMachine(CMD_USER, FAILURE, 1) = 332  ' need account to login
  iFTPStateMachine(CMD_USER, FAILURE, 2) = 530  ' not logged in
  iFTPStateMachine(CMD_USER, FAILURE, 3) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_USER, FAILURE, 4) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_USER, FAILURE, 5) = 421  ' service not avail, closing control connection!
  ' PASS
  iFTPStateMachine(CMD_PASS, SUCCESS, 1) = 230 ' logged in
  iFTPStateMachine(CMD_PASS, SUCCESS, 2) = 202 ' command not implemented superfulous at this site
    
  iFTPStateMachine(CMD_PASS, FAILURE, 1) = 332  ' need account to login
  iFTPStateMachine(CMD_PASS, FAILURE, 2) = 530  ' not logged in
  iFTPStateMachine(CMD_PASS, FAILURE, 3) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_PASS, FAILURE, 4) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_PASS, FAILURE, 5) = 503  ' bad sequence of commands
  iFTPStateMachine(CMD_PASS, FAILURE, 6) = 421  ' service not avail, closing control connection!
  ' CWD
  iFTPStateMachine(CMD_CWD, SUCCESS, 1) = 250  ' requested file action ok, completed
    
  iFTPStateMachine(CMD_CWD, FAILURE, 1) = 530  ' not logged in
  iFTPStateMachine(CMD_CWD, FAILURE, 2) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_CWD, FAILURE, 3) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_CWD, FAILURE, 4) = 502  ' cmd not implemented
  iFTPStateMachine(CMD_CWD, FAILURE, 5) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_CWD, FAILURE, 6) = 550  ' action not taken (file unavail., not found, etc.)
  ' CDUP
  iFTPStateMachine(CMD_CDUP, SUCCESS, 1) = 200  ' command ok
    
  iFTPStateMachine(CMD_CDUP, FAILURE, 1) = 530  ' not logged in
  iFTPStateMachine(CMD_CDUP, FAILURE, 2) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_CDUP, FAILURE, 3) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_CDUP, FAILURE, 4) = 502  ' cmd not implemented
  iFTPStateMachine(CMD_CDUP, FAILURE, 5) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_CDUP, FAILURE, 6) = 550  ' action not taken (file unavail., not found, etc.)
  ' TYPE
  iFTPStateMachine(CMD_TYPE, SUCCESS, 1) = 200  ' command ok
    
  iFTPStateMachine(CMD_TYPE, FAILURE, 1) = 530  ' not logged in
  iFTPStateMachine(CMD_TYPE, FAILURE, 2) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_TYPE, FAILURE, 3) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_TYPE, FAILURE, 4) = 504  ' command not implemented for specified parameter
  iFTPStateMachine(CMD_TYPE, FAILURE, 5) = 421  ' service not avail, closing control connection!
  ' PWD
  iFTPStateMachine(CMD_PWD, SUCCESS, 1) = 257  ' "pathname" created (ok)
    
  iFTPStateMachine(CMD_PWD, FAILURE, 1) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_PWD, FAILURE, 2) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_PWD, FAILURE, 3) = 502  ' cmd not implemented
  iFTPStateMachine(CMD_PWD, FAILURE, 4) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_PWD, FAILURE, 5) = 550  ' action not taken (file unavail., not found, etc.)
  ' SYST
  iFTPStateMachine(CMD_SYST, SUCCESS, 1) = 215  ' NAME system type
    
  iFTPStateMachine(CMD_SYST, FAILURE, 1) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_SYST, FAILURE, 2) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_SYST, FAILURE, 3) = 502  ' cmd not implemented
  iFTPStateMachine(CMD_SYST, FAILURE, 4) = 421  ' service not avail, closing control connection!
  ' QUIT
  iFTPStateMachine(CMD_QUIT, SUCCESS, 1) = 221  ' service closing control connection
    
  iFTPStateMachine(CMD_QUIT, FAILURE, 1) = 500  ' syntax err, cmd not recognized
  ' PASV
  iFTPStateMachine(CMD_PASV, SUCCESS, 1) = 227 ' entering passive mode
    
  iFTPStateMachine(CMD_PASV, FAILURE, 1) = 530  ' not logged in
  iFTPStateMachine(CMD_PASV, FAILURE, 2) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_PASV, FAILURE, 3) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_PASV, FAILURE, 4) = 502  ' cmd not implemented
  iFTPStateMachine(CMD_PASV, FAILURE, 5) = 421  ' service not avail, closing control connection!
  ' LIST
  iFTPStateMachine(CMD_LIST, SUCCESS, 1) = 226  ' closing data connection - requested file action ok
  iFTPStateMachine(CMD_LIST, SUCCESS, 2) = 250  ' requested file action ok, completed
    
  iFTPStateMachine(CMD_LIST, FAILURE, 1) = 425  ' can't open data connection
  iFTPStateMachine(CMD_LIST, FAILURE, 2) = 426  ' connection closed, transfer aborted
  iFTPStateMachine(CMD_LIST, FAILURE, 3) = 450  ' requested file action not taken, file unavailable (.e.g. file busy)
  iFTPStateMachine(CMD_LIST, FAILURE, 4) = 451  ' requested file action aborted: local error processing
  iFTPStateMachine(CMD_LIST, FAILURE, 5) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_LIST, FAILURE, 6) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_LIST, FAILURE, 7) = 502  ' cmd not implemented
  iFTPStateMachine(CMD_LIST, FAILURE, 8) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_LIST, FAILURE, 9) = 530  ' not logged in
  ' RETR
  iFTPStateMachine(CMD_RETR, SUCCESS, 1) = 226  ' closing data connection - requested file action ok
  iFTPStateMachine(CMD_RETR, SUCCESS, 2) = 250  ' requested file action ok, completed
    
  iFTPStateMachine(CMD_RETR, FAILURE, 1) = 425  ' can't open data connection
  iFTPStateMachine(CMD_RETR, FAILURE, 2) = 426  ' connection closed, transfer aborted
  iFTPStateMachine(CMD_RETR, FAILURE, 3) = 450  ' requested file action not taken, file unavailable (.e.g. file busy)
  iFTPStateMachine(CMD_RETR, FAILURE, 4) = 451  ' requested file action aborted: local error processing
  iFTPStateMachine(CMD_RETR, FAILURE, 5) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_RETR, FAILURE, 6) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_RETR, FAILURE, 7) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_RETR, FAILURE, 8) = 530  ' not logged in
  ' STOR
  iFTPStateMachine(CMD_STOR, SUCCESS, 1) = 226  ' closing data connection - requested file action ok
  iFTPStateMachine(CMD_STOR, SUCCESS, 2) = 250  ' requested file action ok, completed
    
  iFTPStateMachine(CMD_STOR, FAILURE, 1) = 425  ' can't open data connection
  iFTPStateMachine(CMD_STOR, FAILURE, 2) = 426  ' connection closed, transfer aborted
  iFTPStateMachine(CMD_STOR, FAILURE, 3) = 450  ' requested file action not taken, file unavailable (.e.g. file busy)
  iFTPStateMachine(CMD_STOR, FAILURE, 4) = 451  ' requested file action aborted: local error processing
  iFTPStateMachine(CMD_STOR, FAILURE, 5) = 551  ' requested action aborted, page type unknown
  iFTPStateMachine(CMD_STOR, FAILURE, 6) = 552  ' requested file action aborted -- exceeded storage allocation
  iFTPStateMachine(CMD_STOR, FAILURE, 7) = 532  ' need an account to stor files
  iFTPStateMachine(CMD_STOR, FAILURE, 8) = 553  ' requested action not taken -- filename not allowed
  iFTPStateMachine(CMD_STOR, FAILURE, 9) = 452  ' requested action not taken -- insufficient storage space in system
  iFTPStateMachine(CMD_STOR, FAILURE, 10) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_STOR, FAILURE, 11) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_STOR, FAILURE, 12) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_STOR, FAILURE, 13) = 530  ' not logged in
  ' APPE
  iFTPStateMachine(CMD_APPE, SUCCESS, 1) = 226  ' closing data connection - requested file action ok
  iFTPStateMachine(CMD_APPE, SUCCESS, 2) = 250  ' requested file action ok, completed
    
  iFTPStateMachine(CMD_APPE, FAILURE, 1) = 425  ' can't open data connection
  iFTPStateMachine(CMD_APPE, FAILURE, 2) = 426  ' connection closed, transfer aborted
  iFTPStateMachine(CMD_APPE, FAILURE, 3) = 450  ' requested file action not taken, file unavailable (.e.g. file busy)
  iFTPStateMachine(CMD_APPE, FAILURE, 4) = 451  ' requested file action aborted: local error processing
  iFTPStateMachine(CMD_APPE, FAILURE, 5) = 551  ' requested action aborted, page type unknown
  iFTPStateMachine(CMD_APPE, FAILURE, 6) = 552  ' requested file action aborted -- exceeded storage allocation
  iFTPStateMachine(CMD_APPE, FAILURE, 7) = 532  ' need an account to stor files
  iFTPStateMachine(CMD_APPE, FAILURE, 8) = 553  ' requested action not taken -- filename not allowed
  iFTPStateMachine(CMD_APPE, FAILURE, 9) = 452  ' requested action not taken -- insufficient storage space in system
  iFTPStateMachine(CMD_APPE, FAILURE, 10) = 500  ' syntax err, cmd not recognized
  iFTPStateMachine(CMD_APPE, FAILURE, 11) = 501  ' syntax err in param or arg
  iFTPStateMachine(CMD_APPE, FAILURE, 12) = 421  ' service not avail, closing control connection!
  iFTPStateMachine(CMD_APPE, FAILURE, 13) = 530  ' not logged in
  iFTPStateMachine(CMD_APPE, FAILURE, 14) = 550  ' action not taken (file unavail., not found, etc.)
  iFTPStateMachine(CMD_APPE, FAILURE, 15) = 502  ' cmd not implemented

End Sub ' InitFTPStateMachine

Private Function bExecCmd(iCmd As Byte) As Boolean
 
  ' This is the work-horse function for this class module
  ' It is called internally to make the actual calls to the
  ' ftp commands that are supported by the CIFTP control
 
  ' NOTE: This function is a candidate to become public.  There are times when
  ' it would be convenient for users to simply invoke one of the supported commands
  ' directly (e.g. TYPE).  However, this would require additional logic to be added
  ' since the routine, in its current form, assumes that a data channel has been
  ' established where necessary, prior to being called.  A better strategy might
  ' be to write additional public routines that perform the needed functions or
  ' to write a general purpose "ProcessFTPCommand" routine that would invoke the
  ' CIFTP.SendFTPCommand.
  
  Dim dtStart As Date, iTimeout As Integer, iSecs As Integer, bTimedOut As Boolean
  
  On Error GoTo bExecCmd_ErrHdlr
        
  bExecCmd = False   ' Assume worst case
  bFileClosed = False  ' Reset flag that indicates that the FileClosed event has fired
  ClearSRQueue         ' Clear the server response queue
  
  Select Case iCmd
'    Case CMD_CONNECT ' connect to access control channel
    Case CMD_USER
      DP "Calling USER..."
      objFTP.USER
    Case CMD_PASS
      DP "Calling PASS..."
      objFTP.PASS
    Case CMD_CWD
      DP "Calling CWD..."
      objFTP.CWD
    Case CMD_CDUP
      DP "Calling CDUP..."
      objFTP.CDUP
    Case CMD_QUIT
      DP "Calling QUIT..."
      objFTP.QUIT
    Case CMD_PASV
      DP "Calling PASV..."
      objFTP.PASV
    Case CMD_TYPE
      DP "Calling TYPE..."
      objFTP.TYPE
    Case CMD_STOR
      DP "Calling STOR..."
      objFTP.STOR
    Case CMD_RETR
      DP "Calling RETR..."
      objFTP.RETR
    Case CMD_LIST
      DP "Calling LIST..."
      objFTP.List
    Case CMD_APPE
      DP "Calling APPE..."
      objFTP.APPE
    Case CMD_PWD
      DP "Calling PWD..."
      objFTP.PWD
    Case CMD_SYST
      DP "Calling SYST..."
      objFTP.SYST
    
    'TO DO: add SendFTPCommand support here
    
    Case Else
      DP "bExecCmd: ERROR - Unknown Command (" & iCmd & ")"
      HandleInternalError
      Exit Function
  
  End Select
  
  ' Now that we've issued the command, wait for the server's response...
  bExecCmd = bWaitOnServerResponse(iCmd)
    
  Exit Function

bExecCmd_ErrHdlr:
  HandleInternalError
  ' no corrective action implemented, just fail
  
End Function ' bExecCmd

Private Function bWaitOnServerResponse(iCmd As Byte) As Boolean
  
  Dim dtStart As Date, iSecs As Integer, bTimedOut As Boolean
  Dim i As Integer, j As Integer, iInitQPos As Integer
  
  On Error GoTo bWaitOnServerResponse_ErrHdlr
  
  bWaitOnServerResponse = False
    
' Check the Server Response Queue for input.  If no conclusive response is found try again until
' either a definitive response is received OR an error is raised OR the timeout period expires...

CheckItOut:

  iInitQPos = iQPos
  For i = 1 To iInitQPos
    For j = 1 To MAX_CODES
      If SRQueue(i).iCode = iFTPStateMachine(iCmd, SUCCESS, j) Then
        DP "Server responded Affirmatively - " & SRQueue(i).iCode
        ' We need to do some special case processing for the RETR and LIST commands
        ' Both of these cause the FileClosed event to fire AFTER the server responds affirmatively,
        ' so we need to wait on these events before considering the command to be completed
        If iCmd = CMD_RETR Or iCmd = CMD_LIST Then
          DP "Waiting on FileClosed event to complete the command..."
          bWaitOnServerResponse = bWaitOnFileClosed()
        Else ' otherwise, we're done
          bWaitOnServerResponse = True
        End If
        Exit Function
      ElseIf SRQueue(i).iCode = iFTPStateMachine(iCmd, FAILURE, j) Then
        DP "Server Responded Negatively! - " & SRQueue(i).iCode
        SetError (ERR_SERVER_REQUEST_FAILED)
        CloseDataControlChannel ' make sure the data channel gets closed
        Exit Function
      Else
        ' The server responded with a code that is not in the state table
        ' Some servers do not strictly follow the RFC, so they may return
        ' a failure code that is not in our state table.  if the code is >= 400,
        ' then the command has failed.  Handle such cases by treating it as
        ' a failed request...
        If SRQueue(i).iCode >= 400 Then
          DP "Server responded with non-standard negative response code - " & SRQueue(i).iCode
          DP "Requested command did not succeed."
          SetError (ERR_SERVER_REQUEST_FAILED)
          CloseDataControlChannel  ' make sure the data channel gets closed
          Exit Function
        End If
      End If
    Next j
  Next i
  
  ' Inconclusive response so pound sand and check again...
  If iQPos <> 0 Then DP "Server did not respond conclusively, waiting for more server responses..."
  bTimedOut = False
  dtLastServerResponse = Now
  While iQPos = iInitQPos And Not bTimedOut And Not bFTPError()
    DoEvents
    If iTimeoutValue > 0 Then ' if a timeout value exists, then check to see if the specified threshold has been reached
      iSecs = DateDiff("s", Now, dtLastServerResponse)
      If Abs(iSecs) > iTimeoutValue Then bTimedOut = True
    End If
  Wend
  If iQPos <> iInitQPos Then
    DP "Checking Response queue for new input..."
    GoTo CheckItOut ' Try again
  ElseIf bTimedOut = True Then
    DP "Timed out waiting for server response!"
    SetError (ERR_TIMED_OUT)
  Else
    ' bFTPError is True
  End If
  
  Exit Function

bWaitOnServerResponse_ErrHdlr:
  HandleInternalError
  
End Function ' WaitOnServerResponse

Private Sub CloseDataControlChannel()
  
' Utility routine that closes the data control channel by calling CleanupDataConnection

  On Error GoTo bCloseControlChannel_ErrHdlr
  
  If bDataControlChannelOpen Then
    DP "Closing data channel via CleanupDataConnection..."
    objFTP.CleanupDataConnection
    bDataControlChannelOpen = False ' this should be set in EventStateChanged, but let's make sure
  End If

  Exit Sub
  
bCloseControlChannel_ErrHdlr:
  HandleInternalError
  
End Sub ' CloseDataControlChannel

Private Function bWaitOnFileClosed() As Boolean

' Wait for the file closed event to fire or for the timeout period to expire.
' Returns True if FileClosed fires, False if timeout expires or an error occurs
  
  Dim dtStart As Date, bTimedOut As Boolean, iSecs As Integer
  
  dtStart = Now
  While Not bFileClosed And Not bTimedOut And Not bFTPError()
    DoEvents
    If iTimeoutValue > 0 Then ' if a timeout value exists, then check to see if the specified threshold has been reached
      iSecs = DateDiff("s", Now, dtStart)
      If Abs(iSecs) > iTimeoutValue Then bTimedOut = True
    End If
  Wend
  bWaitOnFileClosed = bFileClosed
  
  If bTimedOut Then
    ' sometimes the FileClosed event will not fire even though the requested action has completed.
    ' This is an anomaly in the CIFTP control
    DP "Timed out waiting for FileClosed event.  Request MAY NOT have completed"
    SetError (ERR_TIMED_OUT)
  End If
  
End Function ' bWaitOnFileClosed

Private Sub SetError(lCode As Long, Optional vntErrorType)
  
  ' By default errors are assumed to be type "OTHER" (non WSA/Internet)
  If IsMissing(vntErrorType) Then
    LastError.iType = ERROR_TYPE_OTHER
  Else
    LastError.iType = CInt(vntErrorType)
  End If
  LastError.lCode = lCode
  
End Sub ' SetError


Private Function sGetOtherError() As String
   
   Dim sErr As String
   
   On Error Resume Next
   
   Select Case LastError.lCode
      Case ERR_ROUTINE_ERROR
        sErr = Error(iInternaleError)
      Case ERR_BAD_OR_MISSING_PARAM
        sErr = "Bad or Missing Parameter"
      Case ERR_USER_ERROR
        sErr = "User Error"
      Case ERR_CLASS_NOT_INITIALIZED ' user is calling a function w/o first initializing the class
        sErr = "Class not initialized.  bInit must be called before using any class module functions."
      Case ERR_UNEXPECTED_STATE   ' e.g. user calls bLogout, but there access channel is closed
        sErr = "Unexpected FTP state encountered"
      Case ERR_SERVER_REQUEST_FAILED
        sErr = sGetContentOfSRQueue
      Case ERR_ACCESS_CONN_LOST
        sErr = "Access control channel dropped unexpectedly" & vbCrLf & "You may have issued a command without successfully logging in"
      Case ERR_TIMED_OUT
        sErr = "Timeout expired waiting for operation to complete"
      Case ERR_INVALID_FUNC_CALL
        sErr = "Attempted to invoke a function while another function was still executing"
      Case ERR_CMD_ABORTED
        sErr = "Function was aborted (via bAbort) before completing"
      Case ERR_INVALID_ABORT
        sErr = "User called bAbort, but no function was executing"
      Case ERR_NOT_CONNECTED
        sErr = "Not connected to ftp server"
      Case Else
        sErr = "Unknown error (" & LastError.lCode & ")"
   End Select
   sGetOtherError = sErr

End Function ' sGetInternalError
   
Private Sub AddToSRQueue(ByVal iCode As Integer, sMsg As String)
  
  On Error GoTo AddToSRQueue_ErrHdlr
  
  iQPos = iQPos + 1
  If iQPos > QUEUE_SIZE Then iQPos = 1
  
  SRQueue(iQPos).iCode = iCode
  SRQueue(iQPos).sMsg = sMsg
  
'  DP "SRQueue(" & iQPos & ") = " & iCode
  
  Exit Sub

AddToSRQueue_ErrHdlr:
  HandleInternalError
  
End Sub ' AddToSRQueue

Private Function bCheckSRQueue(ByVal iCode As Integer) As Boolean
  
  On Error GoTo bCheckSRQueue_ErrHdlr
  
  Dim i As Integer
  
  bCheckSRQueue = False
  For i = 1 To iQPos
    If SRQueue(i).iCode = iCode Then
      bCheckSRQueue = True
      Exit Function
    End If
  Next
  
  Exit Function
  
bCheckSRQueue_ErrHdlr:
  HandleInternalError
  
End Function ' bCheckSRQueue

Private Function sGetContentOfSRQueue() As String
  
  Dim i As Integer
  
  On Error Resume Next
  
  For i = 1 To iQPos
'    sGetContentOfSRQueue = sGetContentOfSRQueue & SRQueue(i).iCode & " - " & SRQueue(i).sMsg & vbCrLf
    sGetContentOfSRQueue = sGetContentOfSRQueue & SRQueue(i).sMsg & vbCrLf
  Next

End Function ' sGetContentOfSRQueue

Private Sub ClearSRQueue()
  
  On Error Resume Next
  
  Dim i As Integer
  For i = 1 To iQPos
    SRQueue(i).iCode = 0
    SRQueue(i).sMsg = ""
  Next
  iQPos = 0

End Sub ' ClearSRQueue


Private Sub HandleNotLoggedIn()
    
  ' This should be called if the user attempts to make a function call without first logging in to the server
  ' Call bLoggedIn to determine if a server connection is active.

  DP "ERROR: Not connected to ftp server"
  SetError (ERR_NOT_CONNECTED)

End Sub ' HandleNotLoggedIn

Private Sub DP(sMsg As String)
  
  Debug.Print sMsg
  
  ' Could add code here to dump output to a form, listbox, file, etc.
  ' This would be usefull for run time debugging/auditing
  
End Sub ' DP

Private Sub Class_Initialize()
    
  ' Set the initial values of class members...
  Set objFTP = Nothing
  iTimeoutValue = DEFAULT_TIMEOUT
  
  ' You may want to turn these on for debugging purposes.
  ' This can be done here or dynamically from client side code
'  bDumpAccessPackets = True
'  bDumpDataPackets = True
  
End Sub

Private Function bIsIPAddress(sHostName As String) As Boolean

' Determine if the string passed in represents a valid IP address
' While crude and hardly bullet proof, this will work with valid IPs

   Dim ip(4) As String, s As String, iLen As Integer, i As Integer
   On Error GoTo bIPAddress_ErrHdlr
    
 bIsIPAddress = False ' Assume it's not an IP address
 s = sHostName
 i = InStr(1, s, ".")
 If i <> 0 Then
   iLen = Len(s)
   ip(1) = Left(s, i - 1)
   s = Right(s, iLen - i)
   i = InStr(1, s, ".")
   If i <> 0 Then
     iLen = Len(s)
     ip(2) = Left(s, i - 1)
     s = Right(s, iLen - i)
     i = InStr(1, s, ".")
     If i <> 0 Then
       iLen = Len(s)
       ip(3) = Left(s, i - 1)
       s = Right(s, iLen - i)
       i = InStr(1, s, ".")
       If i = 0 Then
         ip(4) = s
         ' if we've gotten this far and all tokens are numeric and less than 3 digits, then we can treat it as an IP address
         For i = 1 To 4
           If Not IsNumeric(ip(i)) Or Len(ip(i)) > 3 Then
             Exit Function
           Else ' also make sure the numbers are within the valid IP limits
             If CInt(ip(i)) < 0 Or CInt(ip(i)) > 255 Then
               Exit Function
             End If
           End If
         Next i
         bIsIPAddress = True ' passed all criteria, so we'll treat it as an IP address
       End If
     End If
   End If
 End If

 Exit Function
  
bIPAddress_ErrHdlr:
  HandleInternalError
  ' if any errors occur processing the name, we don't treat it as an IP address
  
End Function ' bNameIsIPAddress

Private Sub HandleInternalError()
  
  DP "ERROR (" & Err.Number & ") - " & Err.Description
  iInternaleError = Err.Number ' save error number for sGetLastError routine
  SetError ERR_ROUTINE_ERROR
  
End Sub ' HandleInternalError

Private Function bConnectToAccessControlChannel() As Boolean
  
  Dim dtStart As Date, iSecs As Integer, bTimedOut As Boolean
      
  On Error GoTo bConnectToAccessControlChannel_ErrHdlr
    
  bConnectToAccessControlChannel = False ' Assume worst case
  
  If bAccessControlChannelOpen = True Then
    bConnectToAccessControlChannel = True ' we're already connected, so we're done
    Exit Function
  End If
  
  ' We don't have an active access control channel, so request one...
  
  ' Wait until the AccessControlChannelConnection event fires (it sets bAccessControlChannelOpen)...
  bTimedOut = False
  dtStart = Now
  DP "Calling ConnectToAccessControlChannel..."
  objFTP.ConnectToAccessControlChannel
  While bAccessControlChannelOpen = False And Not bTimedOut And Not bFTPError()
    DoEvents
    If iTimeoutValue > 0 Then ' if a timeout value exists, then check to see if the specified threshold has been reached
      iSecs = DateDiff("s", Now, dtStart)
      If Abs(iSecs) > iTimeoutValue Then bTimedOut = True
    End If
  Wend
  ' Set the result value -- if we didn't time out then we got the requested connection...
  
  bConnectToAccessControlChannel = (bTimedOut = False And Not bFTPError())
  Exit Function
  
bConnectToAccessControlChannel_ErrHdlr:
  HandleInternalError

End Function ' bConnectToAccessControlChannel

Private Function bConnectToDataChannel() As Boolean
  
'  Has error handling which expects it to only be called from within a public user function (bGetFile, bPutFile, etc.)

  Dim dtStart As Date, iSecs As Integer, bTimedOut As Boolean, bSuccess As Boolean
      
  On Error GoTo bConnectToDataChannel_ErrHdlr
  
  bConnectToDataChannel = False ' Assume worst case
  ClearErrorFlags ' clear flags indicating that InternetError or WSAError fired
      
  bSuccess = bExecCmd(CMD_PASV)
  If Not bSuccess Then Exit Function ' <-- Early out!
    
  Debug.Print "Data Port Established (" & objFTP.DataPort & ")"
  
  ' Now request a Data Channel...
  bDataControlChannelOpen = False ' reset flag before requesting a channel
                                                     ' We should probably check to see if a data channel is already active
  Debug.Print "Calling ConnectToDataChannel..."
  dtStart = Now
  objFTP.ConnectToDataChannel
  
  ' ===================================== NOTE =====================================
  ' If we are performing an opperation that sends data to the server (APPE/STOR),
  ' then we cannot call DoEvents between the time we connect to the data channel and
  ' the time that we issue the APPE or STOR method.  This is because the control
  ' uses the windows message queue and DoEvents causes potential synchronization
  ' problems.  Therefore, we do an early exit in this case and allow bPutFile to
  ' immediately call STOR or APPE.
  ' ===================================== NOTE =====================================
  
  If sCurrUserFuncName = "bPutFile" Then ' see above note
    bConnectToDataChannel = True
    Exit Function
  End If
  
  ' Wait until the DataChannelConnection event fires and sets our flag...
  While bDataControlChannelOpen = False And Not bTimedOut And Not bFTPError()
    DoEvents
     If iTimeoutValue > 0 Then ' if a timeout value exists, then check to see if the specified threshold has been reached
      iSecs = DateDiff("s", Now, dtStart)
      If Abs(iSecs) > iTimeoutValue Then bTimedOut = True
    End If
  Wend
  ' Set the result value -- if we didn't time out then we got the requested connection...
  bConnectToDataChannel = (bTimedOut = False And Not bFTPError())

  Exit Function
  
bConnectToDataChannel_ErrHdlr:
  HandleInternalError
  
End Function ' bConnectToDataChannel

Private Sub Class_Terminate()
  If bInitialized Then
    Set objFTP = Nothing
  End If
End Sub

Private Sub DumpFTPSettings(iFunction As Integer)
  
  On Error Resume Next
  
  ' Dumps the relevant FTP settings for the specified function
  With objFTP
    Select Case iFunction
      Case USER_FUNC_LOGIN
        DP "HostName = " & .HostName
        DP "HostAddress = " & .HostAddress
        DP "AccessPort = " & .AccessPort
        DP "LoginName = " & .LoginName
        DP "Password = " & .Password
        DP "WorkingDirectory = " & .WorkingDirectory
      Case USER_FUNC_LOGOUT
        DP "HostName = " & .HostName
        DP "HostAddress = " & .HostAddress
      Case USER_FUNC_GET_DIR
        DP "HostName = " & .HostName
        DP "HostAddress = " & .HostAddress
        DP "AccessPort = " & .AccessPort
        DP "WorkingDirectory = " & .WorkingDirectory
      Case USER_FUNC_GET_FILE, USER_FUNC_PUT_FILE
        DP "HostName = " & .HostName
        DP "HostAddress = " & .HostAddress
        DP "AccessPort = " & .AccessPort
        DP "WorkingDirectory = " & .WorkingDirectory
        DP "LocalFileName = " & .LocalFileName
        DP "RemoteFileName = " & .RemoteFileName
      Case Else
        DP "Unknown function value (" & iFunction & ")"
    End Select
  End With
  DP vbCrLf
  
End Sub ' DumpFTPSettings
  
Private Function bInitUserCall(sFuncName As String) As Boolean
  
' NOTE: This should be called at the beginning of each public functions!
  
#If Win32 Then
  Const Pointer = 13 '  ccArrowHourglass
#Else
  Const Pointer = 11 'ccArrow
#End If

  On Error GoTo bInitUserCall_ErrHdlr
  
  ' Don't allow users to call a function if there is another function currently executing...
  If sCurrUserFuncName <> "" Then
    DP "Error user attempted to invoke '" & sFuncName & "' while another function ('" & sCurrUserFuncName & "') was in progress"
'    SetError ERR_INVALID_FUNC_CALL
' We don't want to raise an error here because it will cause the currently executing function to potentially fail
    Exit Function
  Else
    sCurrUserFuncName = sFuncName
  End If
  
  bInitUserCall = False ' Assume worst case
  
  ' Dump header info...
  DP vbCrLf & "============ " & sFuncName & " Started at " & Now & " ============" & vbCrLf
  ' Reset error flags...
  ClearErrorFlags
  ' Set time at which last function was called by the user...
  dtLastUserRequest = Now
  ' Determine if the class module has been initialized...
  bInitUserCall = bClassInitialized()
  ' If we failed then clean up...
  If Not bInitUserCall Then ' failed...
    DP sGetLastError
    EndUserCall
  Else ' success...
    objFTP.Parent.MousePointer = Pointer ' change pointer to hourglass.  EndUserCall resets it
  End If
  
  Exit Function
  
bInitUserCall_ErrHdlr:
  HandleInternalError
  
End Function ' bInitUserCall

Private Sub EndUserCall()
  
  On Error Resume Next
  
  ' NOTE: This must be called at the end of ALL public functions!
  
  ' Dump foter info...
  DP vbCrLf & "=========== " & sCurrUserFuncName & " Completed at " & Now & " ===========" & vbCrLf
  sCurrUserFuncName = "" ' clear function name variable (this will allow users to call another function)

  If bInitialized Then
   objFTP.Parent.MousePointer = 0 ' ccDefault    ' change pointer to default
   ' [should probably save the original shape and restore that,since it may not be the default]
  End If
  
End Sub ' EndUserCall


Private Function bClassInitialized() As Boolean
  
  ' Tests to see if the class has been initialized (via bInit function)
  
  If Not bInitialized Then SetError ERR_CLASS_NOT_INITIALIZED
  bClassInitialized = bInitialized
  
End Function ' bClassInitialized

'Property Let WorkingDirectory(s As String)
'  objFTP.WorkingDirectory = s
'End Property

'Property Get WorkingDirectory() As String
'  WorkingDirectory = objFTP.WorkingDirectory
'End Property

Private Sub ClearErrorFlags()
  
  ' Internal routine that resets the error flags.  This is called in each of the supporting
  ' functions before initiating FTP requests.
  
  LastError.iType = ERROR_TYPE_NONE
  LastError.lCode = 0

End Sub ' ClearErrorFlags

Private Function bFTPError() As Boolean
  
  ' Internal support function to determine if the control fired an error event.
  ' Note that this function relies on the flags being set in the WSAError
  ' and InternetError events...Or by an On Error Handler
    
  bFTPError = (ERROR_TYPE_NONE <> LastError.iType)

End Function ' bFTPError



